home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / CMDLG7 / FONTDLG.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-10  |  3KB  |  137 lines
  1. {µµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµ}
  2. {   \\\                                    }
  3. {  -(j)-                                   }
  4. {    /juanca                               }
  5. {    ~                                     }
  6. {   ⌐ ACASA 1989-1992, All rights reserved }
  7. {µµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµ}
  8.  
  9. {Shell objects around the Print and PrinterSetup dialogs }
  10.  
  11. UNIT FONTDLG;
  12. {$C MOVEABLE DEMANDLOAD DISCARDABLE}
  13. INTERFACE
  14.   USES
  15.     WINTYPES,
  16.     OBJECTS,
  17.     OWINDOWS,
  18.     ODIALOGS,
  19.     COMMDLG,
  20.     COMONDLG;
  21.  
  22.   CONST
  23.     id_FontSample = 1092;
  24.  
  25.              
  26.   TYPE
  27.     pChooseFontDlg= ^tChooseFontDlg;
  28.     tChooseFontDlg = OBJECT ( tCommonDlg )
  29.  
  30.       fontData     :pChooseFont;
  31.  
  32.       CONSTRUCTOR
  33.       init(iparent:PWindowsObject; name :PChar; idata :pChooseFont);
  34.  
  35.       PROCEDURE
  36.       prepareFontData;
  37.         virtual;
  38.  
  39.       FUNCTION
  40.       fontFlags :Longint;
  41.         virtual;
  42.  
  43.       FUNCTION
  44.       execute:Integer;
  45.         virtual;
  46.  
  47.     END;
  48.  
  49. {****************************************************************}
  50. IMPLEMENTATION
  51.  
  52.  
  53.       CONSTRUCTOR
  54.       tChooseFontDlg.
  55.       {}
  56.       init(iparent:PWindowsObject; name :PChar; idata :pChooseFont);
  57.         begin
  58.           inherited init(iparent, name);
  59.           fontData := iData;
  60.         end;
  61.  
  62.       FUNCTION
  63.       tChooseFontDlg.
  64.       {}
  65.       fontFlags :Longint;
  66.         begin
  67.           fontFlags := 0
  68.         end;
  69.  
  70.       PROCEDURE
  71.       tChooseFontDlg.
  72.       {}
  73.       prepareFontData;
  74.         begin
  75.           with fontData^
  76.           do begin
  77.             lStructSize   := sizeof(fontData^);
  78.             hInstance     := SYSTEM.HInstance;
  79.             if parent <> nil
  80.             then
  81.               hwndOwner   := parent^.hWindow
  82.             else
  83.               hwndOwner   := 0;
  84.             lpTemplateName:= attr.Name;
  85.             flags         := flags or fontFlags;
  86.  
  87.             lCustData    := Longint(@Self);  {this does nothing, but could be usefull}
  88.  
  89.             if (lpTemplateName <> nil)
  90.             then
  91.               flags := flags or cf_EnableTemplate;
  92.  
  93.             move(Self.instance, lpfnHook, sizeOf(lpfnHook)); {this does the trick!}
  94.             flags := flags or cf_EnableHook
  95.           end;
  96.         end;
  97.  
  98.  
  99.       FUNCTION
  100.       tChooseFontDlg.
  101.       {}
  102.       execute:Integer;
  103.         var
  104.           result :Integer;
  105.           oldKBHandler :pWindowsObject;
  106.         begin
  107.           prepareFontData;
  108.           oldKbHandler := Application^.KBHandlerWnd;
  109.           isModal      := TRUE;  { this is very important, object gets freed twice otherwise !}
  110.           if COMMDLG.chooseFont(fontData^)
  111.           then
  112.             execute := id_Ok
  113.           else begin
  114.             result := commDlgExtendedError;
  115.             if result = 0
  116.             then
  117.               execute := id_Cancel
  118.             else begin
  119.               execute := -result;
  120.               status  := em_InvalidWindow
  121.             end;
  122.           end;
  123.           with fontData^
  124.           do begin
  125.             @lpfnHook := nil;
  126.             lpTemplateName := nil;
  127.             { clear flags used for dialog }
  128.             flags := flags and not ( cf_EnableTemplate or
  129.                                      cf_EnableHook    
  130.                                      );
  131.           end;
  132.           hwindow := 0;
  133.           isModal := FALSE;
  134.           Application^.KBHandlerWnd := OldKbHandler;
  135.         end;
  136.  
  137. END.